home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak / Leisure Game Pak.iso / lpgame1 / 04 / source / drawstr.pas next >
Pascal/Delphi Source File  |  1994-08-17  |  12KB  |  343 lines
  1. UNIT    DRAWSTR;
  2. (*  This UNIT supplies enhanced line-drawing-routines
  3.     (all lines in angles of k * 45°, with k ε [0..7] in 2 colors).
  4.     The drawing's shape is stored in STRINGs.
  5.                                                  L o O
  6.     The commands are:    [k]{^}DIR  with DIR in   l * r   draw (or move) k
  7.                                                  U u R
  8.                     steps in DIRection using the actual color
  9.                                 (if k is omitted, draw/move 1 step)
  10.                         ^       if uppercase(actual_letter) then INC(k)
  11.                 .    actual color  is  COLOR1
  12.                 :       "     "    is  COLOR2
  13.                         -    switch to MOVE mode  (no drawing is done)
  14.                         +       "   to DRAW mode
  15. *)
  16.  
  17. INTERFACE
  18.  
  19. CONST    LEFT_ALIGNED_TEXT     = 0;
  20.     CENTERED_TEXT         = 1;
  21.         RIGHT_ALIGNED_TEXT    = 2;
  22.  
  23.  
  24. (*  SetDrawColSizeAlign sets the colors and the step  *)
  25. PROCEDURE    SetDrawColSize(col1, col2, step : WORD);
  26.  
  27. { the DTextWidth function returns the width of TXT when drawn with
  28.   the current settings }
  29. FUNCTION    DTextWidth(txt : STRING) : INTEGER;
  30.  
  31. { The DrawText-routines draw a textstring }
  32. PROCEDURE    DrawText(txt : STRING);
  33. PROCEDURE    DrawTextAt(x, y : WORD;  txt : STRING; alignment : BYTE);
  34.  
  35. { DrawString draws the shape stored in s, is_large = TRUE => draw UPCASE letter }
  36. PROCEDURE    DrawStringAt(x, y : WORD;  s : STRING; is_large : BOOLEAN);
  37.  
  38. IMPLEMENTATION
  39.  
  40. USES    GRAPH;
  41.  
  42. TYPE    DIR_TYPE  = 0..7;
  43.     STEP_TYPE = ARRAY[DIR_TYPE] OF INTEGER;
  44.  
  45. (*  IMPLEMENTATION             L  o  O
  46.     The eight directions   l  *  r  shall be coded into an ARRAY OF INTEGER
  47.                                U  u  R
  48.         using a hash function. All we have to do is find a simple hash function
  49.     that associates the character (e.g. 'r') with the corresponding
  50.     direction ('r' should be (+1, 0)).
  51.     To find this function we take advantage of the ASCII coding for
  52.     characters. In ASCII a character is stored in 8 bits, say: 76543210.
  53.     Watching closely we see that bits 5,4,0 are enough to distinguish the
  54.     eight characters we want to use.
  55.     The coding is as follows            540
  56.                     L = 000 = 0,    l = 100 = 4
  57.                     O = 001 = 1,    o = 101 = 5
  58.                     R = 010 = 2,    r = 110 = 6
  59.                     U = 011 = 3,    u = 111 = 7
  60.         Doing this we gain a (comparably) fast access to the directions by
  61.     letter.
  62.         Alternatives:
  63.     Accessing the directions could also be done in a CASE statement
  64.     (which would be more portable), or by an ARRAY['L'..'u'] OF INTEGER
  65.     (which would waste too much memory), or if you consider taking 0..7
  66.     as directions and letters ('a'..'z') as distances (1..26) ...
  67.         In fact, this last alternative is the easiest to design, since we need
  68.     no hash function then (as the directions fit in a 0..7 ARRAY already),
  69.     yet this would be much harder to use later on
  70. *)
  71.                        { L, O, R, U, l, o, r, u }
  72. CONST    SINGLESTEP_X : STEP_TYPE = (-1, 1, 1,-1,-1, 0, 1, 0);
  73.          SINGLESTEP_Y : STEP_TYPE = (-1,-1, 1, 1, 0,-1, 0, 1);
  74.  
  75.     (*  default settings for the colors :  *)
  76.         COLOR1 : WORD = 15;    (* WHITE *)
  77.         COLOR2 : WORD =  8;    (* DKGREY *)
  78.  
  79.     CONVERT : ARRAY[' '..'Z'] OF CHAR =
  80.     ('<','>','/','<','<','<','<','/','<','<','<','<',';','=','.','<',
  81.      '0','1','2','3','4','5','6','7','8','9',':',';','<','<','<','?',
  82.      '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N',
  83.      'O','P','Q','R','S','T','U','V','W','X','Y','Z');
  84.  
  85.         SHAPE  : ARRAY['.'..'Z'] OF STRING[51] =
  86. {.}    ('-r.3o4r:3u4l-5r',
  87. {' = /} '-10o.3o4r:3u2U2l.2O:2l-5R5u',
  88. {0}     '-r.L9oO7r:R9uU7l-3O:o2O.3u2l-3o:3o2r.u2U-6R',
  89. {1}    '-2r.8o:2l.3o7r:11u5l-6r',
  90. {2}    '-r.L5oO4r2o:4l.2o7r:R4uU4l2u.5r:3u8l-9r',
  91. {3}    '.3o5r2o:4l.2o4r2o:4l.2o6r:R3uR5uU8l-10r',
  92. {4}    '-5r.4o:5l.7o4r:4u.2r4o3r:4u.r:3ul4u4l-6r',
  93. {5}    '.3o5r2o:5l.6o8r:2u4l2u.5r:R5uU8l-10r',
  94. {6}    '-r.L9oO7r:2u4l2u.4r:R5uU7l-3O:2o2r.2u2l-3R3r',
  95. {7}    '-2r.5o3O:5l.3o9r:4u2U5u5l-8r',
  96. {8}    '-r.L5oO3oO6r:R3uR5uU8l-3O:2o3r.2u3l-4o:2o3r.2u3l-7R',
  97. {9}    '.3o5r2o:4l.L4oO7r:R9uU8l-3O4o:2o2r.2u2l-7R',
  98. {:}    '-Oo.3o4r:3u4l-4o.3o4r:3u4l-6R',
  99. {, = ;}    '-r.3o4r:3u2U2l.2O:2l-5r',
  100. {  = <}    '-8r',
  101. {- = =}    '-O4o.3o8r:3u8l-5R5r',
  102. {! = >} '-r.3o4r:3u4l-4o.8o4r:8u4l-4Rr',
  103. {?}    '-2r.3o4r:3u4l-4o.3oO3r2o:5l.2o7r:R4uU2l2u4l-4R5r',
  104. {@}    '-2O.2L4o2O4r:2R4u2U4l-o.5O:4uU4l-L:5O.4lU4u-4R4r',
  105. {A}    '.10^oO8r:R10^u4l.5o-2L.2r2o:2l2u-2R:2l5u4l-11r',
  106. {B}    '.11^o8r:R3^uR5uU9l-3Or.3r2o:3l2u-4o.2r2o:2l2u-7R',
  107. {C}    '-r.L9^oO7r:2^u4l6u.5r:3u8l-9r',
  108. {D}    '.11^o9r:R9^uU9l-3Or.2r6o:2l6u-3R4r',
  109. {E}    '.11^o8r:2^u4l2u.3r:2u3l2u.5r:3u9l-10r',
  110. {F}    '.11^o8r:2^u4l2u.3r:2u3l5u4l-9r',
  111. {G}    '-r.L9^oO7r:2^u4l6u.2r3o3r:6u8l-9r',
  112. {H}     '.11^o4r:4u.2r4o4r:11^u4l.5o:2l5u4l-11r',
  113. {I}    '.11^o5r:11^u5l-6r',
  114. {J}    '.4o2rO6^o5r:9^u2U6l-9r',
  115. {K}     '.11^o4r:3^u.rO2^o4r:3^u2U2R4u4l.3oL:l4u4l-11r',
  116. {L}    '.11^o5r:8u.4r:3^u9l-10r',
  117. {M}    '.11^o4^r:2R.2O4^r:11^u4^l.5^o:2U.2L:5^u4^l-13^^r',
  118. {N}    '.11^o4r:3R.3o4r:11^u4l.3o3L:6u4l-12r',
  119. {O}    '-r.L9^oO8r:R9^uU8l-3O:6o2r.6u2l-3R4r',
  120. {P}     '.11^o9r:R4^uU5l5u4l-4O3o:2^o3r.2^u3l-7R',
  121. {Q}    '-r.L9^oO8r:R9^uU8l-3O:6o2r.4ul2ul-3R4r',
  122. {R}     '.11^o9r:R3^uUR5u4l.5o:2l5u4l-4O3o:2^o3r.^uU2l-7R',
  123. {S}     '.3o5r2o:4l.L4^oO7r:2^u4l2u.4r:R5uU8l-10r',
  124. {T}    '-2r.9o:2l.2^o9r:2^u2l9u5l-8r',
  125. {U}    '-2r.2L9^o4r:8u.2r8o4r:9^u2U6l-9r',
  126. {V}    '-4r.4L7^o4r:6uR.O6o4r:7^u4U2l-7r',
  127. {W}    '.11^o5r:5^u.2O:2R.5^o5r:11^u5l.2L:2U5l-15r',
  128. {X}    '.4o2O2L3^o4r:2^uR.O2^o4r:3^u2U2R4u4l.3oL:U3u4l-11r',
  129. {Y}    '-3r.5o3L3^o4r:2^uR.O2^o4r:3^u3U5u4l-8r',
  130. {Z}    '.4o5O:5l.2^o8^r:4u3^U.4r:4u9l-10r');
  131.  
  132.         TotalWidth : LONGINT = 0;
  133.  
  134. VAR    STEP_X, STEP_Y : STEP_TYPE;
  135.  
  136. {
  137.    TYPE    FILL_STATE_TYPE = (INSIDE, OUTSIDE, FROM_INSIDE, FROM_OUTSIDE);
  138.    The ColorFill-procedure is in comments as it doesn't work correctly ...
  139. PROCEDURE    ColorFill(x0, y0, width, height,
  140.               firstcol, lastcol,
  141.               BckgrndCol          : WORD);
  142.  
  143. CONST    LONGLEN = 2;    (*  the maximum height of a border *)
  144. VAR    state         : FILL_STATE_TYPE;
  145.         color, len,
  146.         col_height,
  147.     x, y        : WORD;
  148.         color_dir     : SHORTINT;
  149.         lastline    : ARRAY [0..15] OF WORD;
  150.  
  151. BEGIN
  152.         IF  firstcol > lastcol then
  153.                 color_dir := -1
  154.         ELSE
  155.                 color_dir := 1;
  156.  
  157.     col_height := height DIV SUCC(lastcol - firstcol) * color_dir;
  158.         lastline[firstcol] := y0 + col_height;
  159.  
  160.         color := firstcol;
  161.         REPEAT
  162.         lastline[color + color_dir] := lastline[color] + SUCC(col_height);
  163.                 INC(color, color_dir);
  164.         UNTIL (color = lastcol);
  165.  
  166.     FOR  x := x0  TO  x0 + PRED(width)  DO
  167.         BEGIN
  168.             state := OUTSIDE;
  169.  
  170.                 (* slightly shift the colors *)
  171.                 color := firstcol;
  172.                 WHILE  (color <> lastcol)  DO
  173.         BEGIN
  174.             INC(lastline[color]);
  175.             IF  (lastline[color] > 1)  THEN
  176.                 DEC(lastline[color], Random(3));
  177.                         INC(color, color_dir);
  178.                 END;  (* WHILE color *)
  179.  
  180.                 color := firstcol;
  181.  
  182.             FOR  y := y0  TO  y0 + PRED(height)  DO
  183.                 BEGIN
  184.                         IF  (y > lastline[color])  THEN
  185.                 INC(color, color_dir);
  186.  
  187.                         IF  (GetPixel(x, y) = BckgrndCol)  THEN
  188.                         BEGIN
  189.                 CASE  state  OF
  190.                                   FROM_INSIDE :  IF  (len > LONGLEN)  AND
  191.                                (GetPixel(PRED(x), y) <> BckgrndCol)  THEN
  192.                                                state := INSIDE
  193.                            ELSE
  194.                              state := OUTSIDE;
  195.                                   FROM_OUTSIDE :  IF  (len > LONGLEN)  AND
  196.                                 (GetPixel(PRED(x), y) = BckgrndCol)  THEN
  197.                                                state := OUTSIDE
  198.                            ELSE
  199.                              state := INSIDE;
  200.                 END;  (* CASE *)
  201.                                 len := 0;
  202.                         END  (* IF *)
  203.                         ELSE
  204.                                    CASE  state  OF
  205.                                   FROM_INSIDE, FROM_OUTSIDE :  INC(len);
  206.                                   INSIDE  :  state := FROM_INSIDE;
  207.                                   OUTSIDE :  state := FROM_OUTSIDE;
  208.                                 END;  (* CASE *)
  209.  
  210.                         IF  (state = INSIDE)  THEN
  211.                             PutPixel(x, y, color);
  212.                 END;  (* FOR y *)
  213.         END;  (* FOR x *)
  214. END;    (* ColorFill *)
  215. }
  216.  
  217.  
  218. (*  SetDrawColSizeAlign sets the colors and the step  *)
  219. PROCEDURE    SetDrawColSize(col1, col2, step : WORD);
  220. VAR    dir : BYTE;
  221. BEGIN
  222.     COLOR1 := col1;  COLOR2 := col2;
  223.  
  224.         FOR dir := 0 TO 7 DO
  225.     BEGIN
  226.             STEP_X[dir] := SINGLESTEP_X[dir] * step;
  227.             STEP_Y[dir] := SINGLESTEP_Y[dir] * step;
  228.         END;  (* FOR *)
  229. END;    (*  SetDrawColSize  *)
  230.  
  231.  
  232. (*  DrawString draws the shape stored in s,
  233.     is_large = TRUE => draw UPCASE letters
  234.     really_draw = TRUE => really draw the shape
  235.                 = FALSE => just calculate the the string's total width *)
  236. PROCEDURE    DrawString(s : STRING; is_large, really_draw : BOOLEAN);
  237. VAR    c         : CHAR;
  238.     t         : BYTE;        (*  max string-length is 255  *)
  239.         len         : WORD;
  240.         dir         : DIR_TYPE;    (*  dir ε [0..7]  *)
  241.         draw_is_on     : BOOLEAN;
  242.         sx, sy        : INTEGER;    (* step in x,y direction *)
  243. BEGIN
  244.     t := 0;
  245.         draw_is_on := TRUE;
  246.  
  247.         len := 0;    { length of the next line }
  248.  
  249.         WHILE  (t < Length(s))  DO
  250.         BEGIN
  251.             INC(t);  c := s[t];    (*  get next char  *)
  252.  
  253.                 CASE  c  OF
  254.                    'L'..'W',
  255.            'l'..'w' : BEGIN
  256.                 (* calculate hash function:
  257.                    bits 5,4  -SHIFT->  bits 2,1 *)
  258.                            dir := ((ORD(c) AND $30) SHR 3) OR (ORD(c) AND 1);
  259.  
  260.                 sx := STEP_X[dir];
  261.                                 sy := STEP_Y[dir];
  262.                                 {note that len=0 and len=1 are equivalent}
  263.                 IF  (len > 0)  THEN
  264.                                 BEGIN
  265.                     sx := len * sx;  sy := len * sy;
  266.                                     len := 0;    (* reset len *)
  267.                                 END;
  268.  
  269.                                 IF  (really_draw)  THEN
  270.                                IF  (draw_is_on)  THEN
  271.                         LineRel(sx, sy)
  272.                     ELSE
  273.                         MoveRel(sx, sy)
  274.                                 ELSE
  275.                                     INC(TotalWidth, sx);
  276.  
  277.                     END; (* L..u *)
  278.                    '0'..'9': len := len * 10 + ORD(c) - ORD('0');
  279.  
  280.                    '^'       : IF  (is_large)  THEN    {enlarge this line}
  281.                            IF  (len < 2)  THEN len := 2    {0, 1 => 2}
  282.                                            ELSE INC(len);
  283.  
  284.            '+','-' : draw_is_on := (c = '+');
  285.            '.' :     BEGIN
  286.                    draw_is_on := TRUE;
  287.                                 SetColor(COLOR1);
  288.                             END; (* . *)
  289.            ':' :     BEGIN
  290.                    draw_is_on := TRUE;
  291.                                 SetColor(COLOR2);
  292.                             END; (* : *)
  293.                 END;  (* CASE *)
  294.     END;  (* WHILE *)
  295. END;      (*  DrawString  *)
  296.  
  297. PROCEDURE    DrawStringAt(x, y : WORD;  s : STRING; is_large : BOOLEAN);
  298. BEGIN
  299.         MoveTo(x, y);
  300.         (* now: draw (not measure the string) *)
  301.         DrawString(s, is_large, TRUE);
  302. END;    { DrawStringAt }
  303.  
  304. { the DTextWidth function returns the width of TXT when drawn with
  305.   the current settings }
  306. FUNCTION    DTextWidth(txt : STRING) : INTEGER;
  307. VAR    p       : BYTE;    {max. string length is 255}
  308. BEGIN
  309.         TotalWidth := 0;
  310.     FOR  p := 1  TO  LENGTH(txt)  DO
  311.                 { for uppercase letters 2nd argument is TRUE else FALSE }
  312.         DrawString(SHAPE[CONVERT[UPCASE(txt[p])]], UPCASE(txt[p]) = txt[p], FALSE);
  313.  
  314.         DTextWidth := TotalWidth;
  315. END;    (*  DTextWidth  *)
  316.  
  317.  
  318. { The DrawText-routines draw a textstring }
  319. PROCEDURE    DrawText(txt : STRING);
  320. VAR    p       : BYTE;    {max. string length is 255}
  321.     total_wid : INTEGER;
  322. BEGIN
  323.     FOR  p := 1  TO  LENGTH(txt)  DO
  324.                 { for uppercase letters 2nd argument is TRUE else FALSE }
  325.         DrawString(SHAPE[CONVERT[UPCASE(txt[p])]], UPCASE(txt[p]) = txt[p], TRUE);
  326.  
  327. END;    { DrawText }
  328.  
  329. PROCEDURE    DrawTextAt(x, y : WORD;  txt : STRING; alignment : BYTE);
  330. BEGIN
  331.         CASE  alignment  OF
  332.      {LEFT_ALIGNED_TEXT  :  do nothing}
  333.       CENTERED_TEXT      :  DEC(x, DTextWidth(txt) DIV 2);
  334.       RIGHT_ALIGNED_TEXT :  DEC(x, DTextWidth(txt));
  335.          {ELSE  do nothing}
  336.         END;  (* CASE *)
  337.  
  338.         MoveTo(x, y);
  339.         DrawText(txt);
  340. END;    { DrawTextAt }
  341.  
  342. END.    (*  UNIT  DRAWSTR  *)
  343.